home *** CD-ROM | disk | FTP | other *** search
/ The Arsenal Files 6 / The Arsenal Files 6 (Arsenal Computer).ISO / prg_gen / aspell20.zip / MEMOCHK.PAS < prev    next >
Pascal/Delphi Source File  |  1996-01-19  |  18KB  |  341 lines
  1. unit Memochk;
  2.  
  3. interface
  4.  
  5. { Revisions:
  6.     01/02/96 - Corrected SyncBuffer.  It was not getting the last
  7.                character in the TMemo's buffer.
  8.     01/07/96 - Improved handling of hyphenated words.
  9.     01/09/96 - Added Orpheus Editor component.
  10.     01/11/96 - Added Selection spell checking methods.
  11.     01/12/96 - Improved the look of the suggestion dialog box.
  12.     01/16/96 - Renamed TMemoSpellCheck to TMemoSpell.
  13. }
  14.  
  15. uses
  16.   SysUtils, WinTypes, WinProcs, Messages, Classes, {Graphics,} Controls,
  17.   Forms, Dialogs, StdCtrls, DBCtrls, SugDialg;
  18.  
  19. type SuggestionType = (stNoSuggest, stCloseMatch, stPhoneme);
  20.  
  21. type
  22.   TMemoSpell = class(TComponent)
  23.   private
  24.     { Private declarations }
  25.     FSuggestType         : SuggestionType;  { Holds the default initial suggestion type }
  26.     FDictionaryMain      : string;          { Holds the name of the main dictionary file }
  27.     FDictionaryUser      : string;          { Holds the name of the user's custom dictionary file }
  28.     FSuggestMax          : byte;            { Holds the maximum number of suggestions to return }
  29.     UserDictID           : integer;         { Holds the ID number ofhte open user dictionary }
  30.     FLeaveDictionaryOpen : boolean;         { Should we leave the dictionary files open? }
  31.     FDictionaryOpen      : boolean;          { Is the dictionary open? }
  32.   protected
  33.     { Protected declarations }
  34.     DictDataPtr   : pointer;               { Pointer to internal dictionary data }
  35.     SuggestDialog    : TSugDialog;            { The dialog box for this component }
  36.     StartWord     : string;                { Temporary place to store the word being tested }
  37.     IgnoreList    : TStringList;           { List of words to ignore }
  38.     ReplaceList   : TStringList;           { Replacement word list }
  39.     AlternateList : TStringList;           { Replacement word alternate word list }
  40.     procedure BaseCheckMemo(var TheMemo : TMemo; CheckStart, CheckLength : integer);
  41.   public
  42.     { Public declarations }
  43.     UserDictionaryOpen : boolean;                 { Record if the custom user dictionary was opened ok }
  44.     constructor Create(AOwner : TComponent); override;  { Standard create method }
  45.     procedure Free;                        { Standard free method }
  46.     procedure SetMaximumSuggestions(Max : byte);      { Method to set the maximum number of suggestions }
  47.     property DictionaryOpen : boolean read FDictionaryOpen;
  48.  published
  49.     { Published declarations }
  50.     procedure CheckMemo(TheMemo : TMemo);      { Main method, check the spelling of a TMemo }
  51.     procedure CheckMemoSelection(TheMemo : TMemo); { Alternate method, check the selected text only }
  52.     procedure CheckDBMemo(TheMemo : TDBMemo);  { Main method, check the spelling of a TDBMemo }
  53.     procedure CheckDBMemoSelection(TheMemo : TDBMemo);  { Alternate method, check the selected text only }
  54.     procedure ClearLists;                      { Method to clear the ignore/replace lists }
  55.     property SuggestType : SuggestionType read FSuggestType write FSuggestType default stCloseMatch;
  56.        { Get/Set the initial suggestion type }
  57.     property DictionaryMain : string read FDictionaryMain write FDictionaryMain;
  58.        { Get/Set the name of the main dictionary file }
  59.     property DictionaryUser : string read FDictionaryUser write FDictionaryUser;
  60.        { Get/Set the name of the user dictionary file }
  61.     property MaxSuggestions : byte read FSuggestMax write SetMaximumSuggestions default 10;
  62.        { Get/Set the maximum number of suggestions }
  63.     property LeaveDictionariesOpen : boolean read FLeaveDictionaryOpen write FLeaveDictionaryOpen default TRUE;
  64.        { Get/Set whether the dictionary should be opened/closed after each call }
  65.   end;
  66.  
  67.  
  68. procedure Register;
  69.  
  70. implementation
  71.  
  72. uses BaseASpl;
  73.  
  74.  
  75. procedure Register;  { Standard component registration procedure }
  76. begin
  77.   RegisterComponents('Samples', [TMemoSpell]);
  78. end;
  79.  
  80.  
  81. constructor TMemoSpell.Create(AOwner : TComponent);
  82. { Standard create method }
  83. begin
  84.   inherited Create(AOwner);           { Make sure the base component to made }
  85.   FSuggestType := stCloseMatch;       { Set the default values }
  86.   FDictionaryMain := 'acrop.dct';
  87.   FDictionaryUser := 'custom.dct';
  88.   FLeaveDictionaryOpen := TRUE;
  89.   FDictionaryOpen  := FALSE;
  90.   UserDictionaryOpen := FALSE;
  91.   FSuggestMax     := 10;
  92.   IgnoreList := TStringList.Create;    { Create the list of ignored words }
  93.   IgnoreList.Clear;                    { And set it to the way it is needed to be }
  94.   IgnoreList.Sorted := TRUE;
  95.   ReplaceList := TStringList.Create;   { Create the list of words to replace }
  96.   ReplaceList.Clear;                   { And set it up }
  97.   ReplaceList.Sorted := FALSE;
  98.   AlternateList := TStringList.Create; { Create the list of words to replace with }
  99.   AlternateList.Clear;                 { And set it up }
  100.   AlternateList.Sorted := FALSE;
  101.   InitDictionaryData(DictDataPtr);        { Create the internal dictionary data }
  102.   SuggestDialog := TSugDialog.Create(Self);  { Create the dialog box }
  103.   SuggestDialog.DictDataPtr := DictDataPtr;  { And let it know the internal data address }
  104. end;
  105.  
  106. procedure TMemoSpell.Free;
  107. { Standard free method }
  108. begin
  109.   if FDictionaryOpen then
  110.     BaseASpl.CloseDictionaries(DictDataPtr);
  111.   IgnoreList.Free;     { Get rid of the ignore list }
  112.   ReplaceList.Free;    { Get rid of the replacement list }
  113.   AlternateList.Free;  { Get rid of the replacement word list }
  114.   SuggestDialog.Free;  { Get rid of the suggestion dialog box }
  115.   inherited Free;      { and then the base component }
  116. end;
  117.  
  118. procedure TMemoSpell.SetMaximumSuggestions(Max : byte);
  119. { Set the maximum number of suggestions to return }
  120. { The test of check to see if it is over thirty is really not needed since the }
  121. { low level routines in BaseASpl will force any value over 30 to 30 anyway     }
  122. begin
  123.   if Max > 30 then      { Make sure it isn't over 30 }
  124.     Max := 30;
  125.   FSuggestMax := Max;   { And store the value }
  126. end;
  127.  
  128. procedure TMemoSpell.ClearLists;
  129. begin
  130.   IgnoreList.Clear;                    { Clear the ignore list }
  131.   IgnoreList.Sorted := TRUE;
  132.   ReplaceList.Clear;                   { Clear the list of words to replace }
  133.   ReplaceList.Sorted := FALSE;
  134.   AlternateList.Clear;                 { Clear the list of words to do the replacing with }
  135.   AlternateList.Sorted := FALSE;
  136. end;
  137.  
  138.  
  139. procedure TMemoSpell.BaseCheckMemo(var TheMemo : TMemo; CheckStart, CheckLength : integer);
  140. { The main method for this component.  Test the spelling of the text in the passed memo }
  141. type LargeBuffer = array[0..32800] of char; { A little over 32K - the limit on memo's size }
  142.      LargeBufferPtr = ^LargeBuffer;
  143. var Done       : boolean;        { Loop control }
  144.     OldHide    : boolean;        { Storage for the original state of the HideSelection property }
  145.     Changed    : boolean;        { Was anything in the memo changed? }
  146.     EmptyList  : TStringList;    { Empty list in case user dictionary need to be made }
  147.     HoldBuffer : LargeBufferPtr; { Buffer to speed up finding words }
  148.     Start      : integer;        { Start of the word }
  149.     WordEnd    : integer;        { End of the word }
  150.     CheckLoc   : integer;        { Location we are currently checking }
  151.     TheResult  : integer;        { Temporary ShowModal return storage }
  152.   procedure SyncBuffer;
  153.   { Duplicate the memo's text into the temporary buffer }
  154.   begin
  155.     TheMemo.GetTextBuf(HoldBuffer^, TheMemo.GetTextLen+1);
  156.     { No need to worry about the length.  TMemo buffers are 32K or smaller }
  157.   end;
  158.   function GetNextWord : string;
  159.   { Get the next word in the memo }
  160.   var CurrentTextLen    : integer;  { Temporary to hold length of memo's text }
  161.       CurrentPos        : integer;
  162.       S                 : string;
  163.   begin
  164.     { Scan until we find the start of a word.  Defined as someting starting with a letter }
  165.     CurrentTextLen := TheMemo.GetTextLen;  { Just to speed things up a litte }
  166.     CurrentPos := CheckLoc;         { Start at the selection }
  167.     while (CurrentPos < CurrentTextLen) and
  168.            (not (HoldBuffer^[CurrentPos] in ['A'..'Z','a'..'z',        { The english letters and }
  169.                                              #138,#140,#159,           { non-english characters  }
  170.                                              #192..#214,#216..#223,#240,
  171.                                              #154,#156,#224..#239,
  172.                                              #241..#246,#248..#255])) do
  173.       Inc(CurrentPos);  { Move to the next character }
  174.     Start := CurrentPos;   { Record the actual start of the word }
  175.     { Find the end of the word.  The word ends when a non-letter character }
  176.     { or the character "'" is found.  }
  177.     S := '';
  178.     while (CurrentPos < CurrentTextLen) and
  179.             (HoldBuffer^[CurrentPos] in ['A'..'Z','a'..'z','''',
  180.                                          #138,#140,#159,
  181.                                          #192..#214,#216..#223,#240,
  182.                                          #154,#156,#224..#239,
  183.                                          #241..#246,#248..#255]       ) do
  184.       begin
  185.         S := S + HoldBuffer^[CurrentPos];   { Add it to the current word }
  186.         Inc(CurrentPos);  { Move to the next character }
  187.       end;
  188.     WordEnd := CurrentPos;                   { Save the end of the word }
  189.     GetNextWord := S;                        { Return the found word }
  190.   end;
  191. begin
  192.   try
  193.   HoldBuffer := NIL;
  194.   New(HoldBuffer);    { Create a temporary buffer to hold a copy of the memo's text }
  195.   Changed := FALSE;  { Nothing has been changed yet. }
  196.   OldHide := TheMemo.HideSelection;         { Save the old HideSelection property }
  197.   TheMemo.HideSelection := FALSE;           { and make sure selections are shown }
  198.   SuggestDialog.MaxSuggest := FSuggestMax;  { Set the maximum number of suggestions }
  199.   if not FDictionaryOpen then  { Check to see if the dictionary is already open }
  200.     begin
  201.       FDictionaryOpen := BaseASpl.OpenDictionary(DictDataPtr, FDictionaryMain);  { Open the dictionaries }
  202.       UserDictID := BaseASpl.OpenUserDictionary(DictDataPtr, FDictionaryUser);  { And record if they actually opened }
  203.       if UserDictID < 0 then        { Didn't open so try to make one }
  204.         begin
  205.           EmptyList := TStringList.Create;   { Create and clear to make an empty list }
  206.           EmptyList.Clear;
  207.           UserDictID := BaseASpl.BuildUserDictionary(DictDataPtr, FDictionaryUser, EmptyList);  { Build dictionary }
  208.           EmptyList.Free;  { Free the empty list }
  209.         end;
  210.       UserDictionaryOpen := UserDictID > 0;  { Check to see if dictionary was opened/made }
  211.     end;
  212.   SyncBuffer;  { Load the text into a easy to access buffer }
  213.   with SuggestDialog do  { The suggestion dialog is used a lot so make it easily accessible }
  214.     begin
  215.       TheMemo.SelLength := 0;   { Set up no selection and move to the }
  216.       TheMemo.SelStart := 0;    { start of the section to check }
  217.       CheckLoc := CheckStart;   { Start at the section to spell check }
  218.       Done := FALSE;            { Assume we aren't done }
  219.       repeat
  220.         StartWord := GetNextWord;       { Get the next word in the memo }
  221.         IF not BaseASpl.GoodWord(DictDataPtr, StartWord) THEN  { Is the word in the dictionaries? }
  222.           if IgnoreList.IndexOf(Uppercase(StartWord)) = -1 then  { No, is it in the ignore list? }
  223.             begin  { Word not found and not ignored }
  224.               TheMemo.SelStart  := Start;             { Highlight the word }
  225.               TheMemo.SelLength := WordEnd - Start;
  226.               WordEdit.Text := StartWord;    { Setup the Suggestion dialog }
  227.               NotWord.Text := StartWord;     { Setup the word we are checking }
  228.               ActiveControl := BtnIgnore;    { And make the Ignore button active }
  229.               if ReplaceList.IndexOf(StartWord) = -1 then  { In the replacement list? }
  230.                 begin
  231.                   case FSuggestType of           { Build an inital list of suggestions }
  232.                     stCloseMatch : SuggestList.Items := BaseASpl.SuggestCloseMatch(DictDataPtr, StartWord, FSuggestMax);
  233.                     stPhoneme    : SuggestList.Items := BaseASpl.SuggestPhoneme(DictDataPtr, StartWord, FSuggestMax);
  234.                     stNoSuggest  : SuggestList.Clear;
  235.                   end;
  236.                   TheResult := ShowModal;  { Show the dialog box }
  237.                end
  238.               else
  239.                 begin
  240.                   TheResult := 101;  { Fake Replace Button being pressed }
  241.                   WordEdit.Text := AlternateList.Strings[ReplaceList.IndexOf(StartWord)]; { And get the replacement word }
  242.                 end;
  243.                case TheResult of   { Display the suggestion dialog }
  244.                 100 : Done := TRUE;                            { Cancel - end the spell checking }
  245.                 101,
  246.                 105 : begin   { Replace }
  247.                         TheMemo.SelText := WordEdit.Text;        { Replace - replace the word with the correction }
  248.                         Changed := TRUE;
  249.                         SyncBuffer;                              { Resync the temp buffer }
  250.                         WordEnd := TheMemo.SelStart + TheMemo.SelLength;   { Reset the end of word }
  251.                         CheckLength := CheckLength + (Length(WordEdit.Text) - Length(StartWord)); { Adjust ending length }
  252.                         if TheResult = 105 then { Replace all occurences }
  253.                           begin
  254.                             ReplaceList.Add(StartWord);
  255.                             AlternateList.Add(WordEdit.Text);
  256.                           end;
  257.                       end;
  258.                       { Add - the questioned word to the user dictionary }
  259.                 102 : BaseASpl.AddWord(DictDataPtr, StartWord, UserDictID);
  260.                 103 : ; { Ignore just this occurence - Don't do anything }
  261.                 104 : IgnoreList.Add(Uppercase(StartWord));    { Ignore All - add the questioned word to the ignore list }
  262.               end;
  263.             end;
  264.         CheckLoc := WordEnd+1;  { Move to one character after the end of the current word }
  265.       until Done or (CheckLoc >= (CheckLength+CheckStart));  { Canceled or end of the memo is reached }
  266.     end;
  267.   finally
  268.     Dispose(HoldBuffer);              { Release the temporary buffer }
  269.     if not FLeaveDictionaryOpen then  { Check if the dictionaries should be closed }
  270.       begin
  271.         BaseASpl.CloseDictionaries(DictDataPtr);       { Close the dictionaries  }
  272.         FDictionaryOpen := FALSE;          { Mark them as not opened }
  273.         UserDictionaryOpen := FALSE;
  274.       end;
  275.     TheMemo.HideSelection := OldHide; { Restore the HideSelection property of the memo }
  276.     if not Changed then    { Let the user know something actually happened }
  277.       MessageDlg('No changes made', mtInformation, [mbOK], -1)
  278.     else
  279.       MessageDlg('Checking complete', mtInformation, [mbOK], -1);
  280.   end;
  281. end;
  282.  
  283.  
  284. procedure TMemoSpell.CheckMemo(TheMemo : TMemo);
  285. begin
  286.   BaseCheckMemo(TheMemo, 0, TheMemo.GetTextLen+1);  { Check the whole memo }
  287. end;
  288.  
  289. procedure TMemoSpell.CheckMemoSelection(TheMemo : TMemo);
  290. var CheckStart, CheckLength : integer;
  291. begin
  292.   with TheMemo do
  293.     begin
  294.       if SelLength = 0 then  { Make sure there is something selected }
  295.         exit;                { If not then there is nothing to check }
  296.      { Make sure we have a whole word at the start of the selection }
  297.       CheckStart  := SelStart;   { Get the start of the selection }
  298.       CheckLength := SelLength;  { And the length }
  299.       SelLength := 1;  { Only look at one character at a time }
  300.       while (CheckStart <> 0) and (TheMemo.SelText[1] in ['A'..'Z','a'..'z',
  301.                                                           #138,#140,#159,
  302.                                                           #192..#214,#216..#223,#240,
  303.                                                           #154,#156,#224..#239,
  304.                                                           #241..#246,#248..#255]) do
  305.         begin
  306.           Dec(CheckStart);         { Move back another charater }
  307.           Inc(CheckLength);        { and expand the length to check }
  308.           if SelStart <> 0 then
  309.             SelStart := SelStart - 1;   { then look at the charcter before that }
  310.           SelLength := 1;
  311.         end;
  312.      { Now make sure we have a whole word at the end of the selection }
  313.       SelStart := CheckStart + CheckLength;  { Move to the end of the selected text }
  314.       SelLength := 1;  { Look at only a single charater }
  315.       while (SelStart < GetTextLen) and (SelText[1] in ['a'..'z','A'..'Z',
  316.                                                         #138,#140,#159,
  317.                                                         #192..#214,#216..#223,#240,
  318.                                                         #154,#156,#224..#239,
  319.                                                         #241..#246,#248..#255]) do
  320.         begin
  321.           Inc(CheckLength);          { Expand the selection length by one character }
  322.           if SelStart < GetTextLen then  { And move to the next if possible }
  323.             SelStart := SelStart + 1;
  324.           SelLength := 1;
  325.         end;
  326.     end;
  327.   BaseCheckMemo(TheMemo, CheckStart, CheckLength);  { Check the selected region }
  328. end;
  329.  
  330. procedure TMemoSpell.CheckDBMemo(TheMemo : TDBMemo);
  331. begin
  332.   CheckMemo(TMemo(TheMemo));
  333. end;
  334.  
  335. procedure TMemoSpell.CheckDBMemoSelection(TheMemo : TDBMemo);
  336. begin
  337.   CheckMemoSelection(TMemo(TheMemo));
  338. end;
  339.  
  340. end.
  341.